home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / adx7mu1a / module1.bas < prev    next >
Encoding:
BASIC Source File  |  1999-10-10  |  7.7 KB  |  225 lines
  1. Attribute VB_Name = "Module1"
  2. Global usermode As String 'sets usermode host or client
  3. Global multiplayermode As Boolean 'Sets multiplayer yes no
  4. Global MyTurn As Boolean 'My turn switch
  5. Global profilename As Variant 'name for your machine
  6. Global opponentsname As Variant 'name for remote machine
  7. Global score As Integer ' keeps track of game score
  8. Global profilenamescore As Integer 'your score
  9. Global opponentsscore As Integer 'remote score
  10. Global sw As Boolean 'set whether x or o goes first
  11. ' Constants
  12. Public Const MaxPlayers = 2
  13. Public Const MChatString = 60
  14.  
  15. ' DirectPlay stuff
  16. Public dx7 As New DirectX7
  17. Public dxplay As DirectPlay4
  18. Public EnumConnect As DirectPlayEnumConnections
  19. Public onconnect As Boolean
  20. Public gNumPlayersWaiting As Byte
  21. Public MyPlayer As Long
  22. Public EnumSession As DirectPlayEnumSessions
  23. Public numplayers As Byte
  24. Public dxHost As Boolean
  25. Public CurrentPlayer As Integer
  26. Public PlayerScores(MaxPlayers) As Byte
  27. Public PlayerIDs(MaxPlayers) As Long
  28. Public dxMyTurn As Integer
  29. Public GameUnderway As Boolean
  30. Public connectionmade As Boolean
  31.  
  32. 'The appguid number was generated with the utility provide with DX7 SDK.
  33. Public Const AppGuid = "{D4D5D10B-7D04-11D3-8E64-00A0C9E01368}"
  34.  
  35. 'This defines the msgtype you will send with DXplay.send
  36. Public Enum MSGTYPES
  37.     MSG_STOP 'Handles user diconnect
  38.     MSG_STARTGAME 'Startgame
  39.     MSG_CHAT_ON 'Chat on or off
  40.     MSG_CHAT    'chat input
  41.     MSG_RESTART 'Restart Game
  42.     MSG_XORO 'Select if X or O Starts game
  43.     MSG_MOVE 'What square selected
  44. End Enum
  45. Public Sub CloseDownDPlay() 'this shuts down directplay
  46.   dxHost = False
  47.   GameUnderway = False
  48.   Set EnumConnect = Nothing
  49.   Set EnumSession = Nothing
  50.   Set dxplay = Nothing
  51. End Sub
  52. ' Main procedure. This is where we poll for DirectPlay messages in idle time.
  53. Public Sub Main()
  54. MainBoard.Show
  55.   Do While DoEvents()  ' allow event processing while any windows open
  56.     DPInput
  57.   Loop
  58. End Sub
  59. ' Receive and process DirectPlay Messages
  60. Public Sub DPInput()
  61.   Dim FromPlayer As Long
  62.   Dim ToPlayer As Long
  63.   Dim msgsize As Long
  64.   Dim msgtype As Long
  65.   Dim dpmsg As DirectPlayMessage
  66.   Dim MsgCount As Long
  67.   Dim msgdata() As Byte
  68.   Dim x As Integer
  69.   Dim fromplayername As String
  70.      
  71.   If dxplay Is Nothing Then Exit Sub 'IF  single player then exit
  72.     
  73.   On Error GoTo NOMESSAGE
  74.   ' If this call fails, presumably it's because there's no session or
  75.   ' no player.
  76.   MsgCount = dxplay.GetMessageCount(MyPlayer) 'Get number of messages.
  77.   On Error GoTo MSGERROR
  78.   Do While MsgCount > 0 'Read all messages
  79.     Set dpmsg = dxplay.Receive(FromPlayer, ToPlayer, DPRECEIVE_ALL) 'Read DXINput
  80.     msgtype = dpmsg.ReadLong() 'Read DXinput msg TYPE
  81.     MsgCount = MsgCount - 1
  82.     'Direct X System Only Messages not user defineable
  83.     If FromPlayer = DPID_SYSMSG Then
  84.     
  85.       Select Case msgtype
  86.       ' New player, update player list
  87.         Case DPSYS_DESTROYPLAYERORGROUP, _
  88.              DPSYS_CREATEPLAYERORGROUP
  89.          
  90.           If Connect.Visible Then Connect.UpdateWaiting 'update connection sessions list
  91.           
  92.           
  93.           Case DPSYS_HOST 'either lost connection or changed you to host
  94.             dxHost = True
  95.              If Connect.Visible Then
  96.                MsgBox ("You are now the host.")
  97.                Connect.UpdateWaiting   ' make sure Start button is enabled
  98.             End If
  99.           
  100.       End Select
  101. ' ---------------------------------------------------------------------------------------
  102.     
  103.     ' User specified Message Structure TYPES
  104.     
  105.     Else
  106.     
  107.       ' Get name of sending player
  108.       If onconnect = False Then
  109.       fromplayername = dxplay.GetPlayerFriendlyName(FromPlayer) 'Gets name
  110.       opponentsname = fromplayername 'changes to games variable
  111.             'Updates status bars and labels.
  112.             If usermode = "host" Then
  113.                 MainBoard.playerdisplaylabel.Caption = opponentsname & " Has Joined The Game"
  114.                 MainBoard.StatusBar1.SimpleText = opponentsname & "Is Ready To Play,  Start Game"
  115.             End If
  116.             If usermode = "client" Then
  117.                 MainBoard.playerdisplaylabel.Caption = "You Have Joined " & opponentsname & "'s Game"
  118.                 MainBoard.StatusBar1.SimpleText = opponentsname & " Will Start The Game"
  119.             End If
  120.          End If
  121.          onconnect = True
  122.          Select Case msgtype
  123.      'Below is where you define your message structure types and add responding code, cool.
  124.      Case MSG_STARTGAME
  125.         onconnect = True
  126.           multiplayermode = True
  127.           ' Number of players
  128.           numplayers = dpmsg.ReadByte
  129.           ' Player IDs,
  130.             MyPlayer = dpmsg.ReadLong
  131.           ' Show the game board.
  132.             Connect.Hide
  133.             MainBoard.Enabled = True
  134.             MainBoard.Show
  135.             MainBoard.hostagame.Enabled = False
  136.             MainBoard.joinagame.Enabled = False
  137.             MainBoard.mnudisconnect.Enabled = True
  138.         
  139.      Case MSG_MOVE 'Sent when square is click
  140.             Dim t As Byte
  141.                 t = dpmsg.ReadByte
  142.                 
  143.         Select Case t
  144.             Case 0
  145.                 Call MainBoard.layer_A_online(0)
  146.             Case 1
  147.                 Call MainBoard.layer_A_online(1)
  148.             Case 2
  149.                 Call MainBoard.layer_A_online(2)
  150.             Case 3
  151.                 Call MainBoard.layer_A_online(3)
  152.             Case 4
  153.                 Call MainBoard.layer_A_online(4)
  154.             Case 5
  155.                 Call MainBoard.layer_A_online(5)
  156.             Case 6
  157.                 Call MainBoard.layer_A_online(6)
  158.             Case 7
  159.                 Call MainBoard.layer_A_online(7)
  160.             Case 8
  161.                 Call MainBoard.layer_A_online(8)
  162.             End Select
  163.      MyTurn = True
  164.      
  165.        Case MSG_CHAT_ON          'Handles Turn chat on off
  166.             Call MainBoard.chatswitch
  167.          
  168.         Case MSG_XORO 'Selects who goes first X or O
  169.         Dim thing As Byte
  170.         thing = dpmsg.ReadByte
  171.         If thing = 1 Then
  172.             Call MainBoard.x_Click
  173.         End If
  174.         If thing = 2 Then
  175.             Call MainBoard.o_Click
  176.         End If
  177.      
  178.         Case MSG_RESTART 'handles input for restart
  179.                multiplayermode = True
  180.                 MainBoard.playerdisplaylabel.Caption = opponentsname & " has restarted the game."
  181.                         If sw = True Then
  182.                             MyTurn = False
  183.                         Else
  184.                             MyTurn = True
  185.                         End If
  186.                          Call MainBoard.restart_Click
  187.                         
  188.         Case MSG_CHAT 'Handles Chat String input
  189.           Dim chatin As String
  190.                 chatin = dpmsg.ReadString()
  191.                If MainBoard.chatlabel.Text = "" Then
  192.                  MainBoard.chatlabel.Text = opponentsname & ": " & chatin
  193.                     Else
  194.                  MainBoard.chatlabel.Text = MainBoard.chatlabel.Text & vbCrLf & opponentsname & ": " & chatin
  195.                 End If
  196.                 
  197.          Case MSG_STOP 'Handles player disconnected.
  198.           MsgBox opponentsname & " has left the game.", vbOKOnly, "Tic Tac Oops"
  199.                 MainBoard.mnudisconnect.Enabled = False
  200.                 MainBoard.newgame.Enabled = True
  201.                 MainBoard.hostagame.Enabled = True
  202.                 MainBoard.joinagame.Enabled = True
  203.                 multiplayermode = False
  204.                 usermode = "host"
  205.                 Call CloseDownDPlay
  206.                 Unload Connect
  207.                 onconnect = False
  208.     End Select
  209.    
  210. End If
  211.     
  212.   Loop
  213.   Exit Sub
  214.   
  215. ' Error handlers
  216. MSGERROR:
  217.   MsgBox ("Error reading message.")
  218.   CloseDownDPlay
  219.   End
  220. NOMESSAGE:
  221.   Exit Sub
  222. End Sub
  223.  
  224.  
  225.